perm filename VIXSUB.FAI[VIS,HPM]4 blob sn#150659 filedate 1975-03-15 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	VIXSUB
C00005 00003	TONUP:	0
C00008 00004	******************** SAIL INTERFACE ***********************
C00014 00005	
C00020 ENDMK
C⊗;
	TITLE	VIXSUB
	EXTERN	XL,YH,XSC,YSC
	EXTERN	SLINE,DBUF,BSK,SCRTCH
	EXTERN	CORGET,CORREL
	ENTRY	VIDEO

ARRY←5 ↔ X1←1 ↔ Y1←2 ↔ X2←3 ↔ Y2←4 ↔ BT←0 ↔ XA←6 ↔ YA←7
DX←10 ↔ DY←11 ↔ PICX←12 ↔ PICY←13 ↔ XBIT←14 ↔ XPIC←15 ↔ YPIC←16 ↔ T←17

GRYUP:	0
	MOVE	T,ROWTAB
	HRRM	T,RTF
	MOVE	T,COLTAB
	HRRM	T,CTF
	HRRM	BT,TI
	CAML	X1,X2			;PUT UP THE BITS MASKED BY BT
	EXCH	X1,X2			;OF PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2
	HRREI	XA,1(X2)
	SUB	XA,X1
	HRREI	YA,1(Y2)
	SUB	YA,Y1
	HRLZ	DX,PICWID
	IDIV	DX,XA
	HRLZ	DY,PICHIG
	IDIV	DY,YA
	SETZB	PICY,PICX
	JUMPGE	Y1,YLOK			;CHECK IF LOWER AND UPPER
	MOVN	PICY,Y1			;BOUNDS NEED FIXING UP
	IMUL	PICY,DY
	SETZ	Y1,
YLOK:	CAILE	Y2,740
	MOVEI	Y2,740
	JUMPGE	X1,XLOK
	MOVN	PICX,X1
	IMUL	PICX,DX
	SETZ	X1,
XLOK:	CAIL	X2,21*40
	MOVEI	X2,21*40
	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	@GRYUP
	SUBM	X1,X2
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)
	MOVE	YA,Y1
YLLP:	HLRZ	YPIC,PICY
RTF:	MOVE	YPIC,ROWTAB(YPIC)
	MOVEM	YPIC,SCRTCH(YA)
	ADD	PICY,DY
	AOBJN	YA,YLLP

XLP:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TJ
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLP:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
	MOVE	YPIC,SLINE(YA)
TI:	TRNE	T,BT			;REPLACED BY ACTUAL MASK
TJ:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
	AOBJN	YA,YLP

	ADD	PICX,DX
	AOBJN	X1,XLP
	JRST	@GRYUP
TONUP:	0
	MOVE	T,ROWTAB
	HRRM	T,RTF1
	MOVE	T,COLTAB
	HRRM	T,CTF1
	MOVN	BT,PICBIT
	SUBI	BT,1
	HRRM	BT,TIH
	MOVEI	BT,737373
	CAML	X1,X2			;PUT UP THE
	EXCH	X1,X2			;PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2			;AS A RANDOM DOT PATTERN
	HRREI	XA,1(X2)
	SUB	XA,X1
	HRREI	YA,1(Y2)
	SUB	YA,Y1
	HRLZ	DX,PICWID
	IDIV	DX,XA
	HRLZ	DY,PICHIG
	IDIV	DY,YA
	SETZB	PICY,PICX
	JUMPGE	Y1,YLOKH		;CHECK IF LOWER AND UPPER
	MOVN	PICY,Y1			;BOUNDS NEED FIXING UP
	IMUL	PICY,DY
	SETZ	Y1,
YLOKH:	CAILE	Y2,740
	MOVEI	Y2,740
	JUMPGE	X1,XLOKH
	MOVN	PICX,X1
	IMUL	PICX,DX
	SETZ	X1,
XLOKH:	CAIL	X2,21*40
	MOVEI	X2,21*40
	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	@TONUP
	SUBM	X1,X2
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)
	MOVE	YA,Y1
YLLPH:	HLRZ	YPIC,PICY
RTF1:	MOVE	YPIC,ROWTAB(YPIC)
	MOVEM	YPIC,SCRTCH(YA)
	ADD	PICY,DY
	AOBJN	YA,YLLPH

XLPH:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TJH
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF1:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLPH:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
TIH:	ROT	T,-5			;REPLACED BY -PICBIT-1
	MOVE	YPIC,SLINE(YA)
        IMULI	BT,400003
	CAMLE	T,BT			;REPLACED BY ACTUAL MASK
TJH:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
	AOBJN	YA,YLPH

	ADD	PICX,DX
	AOBJN	X1,XLPH
	JRST	@TONUP
;******************** SAIL INTERFACE ***********************
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BPTAB←←12
LINTAB←←13

PICWID:	0
PICLIN:	0
PICHIG:	0
PICBIT:	0
PICWIZ:	0
PICSIZ:	0
COLTAB:	0
ROWTAB:	0

SETUP:	0
	MOVE	T,PCWD(ARRY)		;SET "GLOBALS" FOR COMPATABILITY WITH
	MOVEM	T,PICSIZ		;OLD FORMAT
	MOVE	T,LNBYA(ARRY)
	MOVEM	T,PICWIZ
	MOVE	T,BYBI(ARRY)
	MOVEM	T,PICBIT
	MOVE	T,PCLN(ARRY)
	MOVEM	T,PICHIG
	MOVE	T,LNWD(ARRY)
	MOVEM	T,PICLIN
	MOVE	T,LNBY(ARRY)
	MOVEM	T,PICWID
	MOVE	T,BPTAB(ARRY)
	MOVEM	T,COLTAB
	MOVEI	T,LINTAB(ARRY)
	MOVEM	T,ROWTAB
	MOVE	ARRY,(T)
	JRST	@SETUP


	P←17

	DEFINE	FLOAT(N)
<	TLC	N,232000
	FADR	N,N	>

	OPDEF	FIX[247000233000]

	DEFINE	SAVAC(N)
<	IFGE	N-12,{MOVEM 12,ACS12}
	IFGE	N-16,{MOVEM 16,ACS16}
	IFGE	N-17,{MOVEM 17,ACS17}	>


	DEFINE	RESAC(N)
<	IFGE	N-12,{MOVE 12,ACS12}
	IFGE	N-16,{MOVE 16,ACS16}
	IFGE	N-17,{MOVE 17,ACS17}	>

RETAD:	0
ACS12:	0
ACS16:	0
ACS17:	0

VIDEO:	POP	P,RETAD		;PUT UP BITS BT (A MASK, USUALLY ONLY ONE BIT
	POP	P,BT		;IS ON, IF MULTIPLE BITS ARE ON, THEY ARE OR'D)
	POP	P,ARRY		;OF PICTURE PIC INTO DD RECTANGLE X1-X2,Y1-Y2
	POP	P,Y2		; VIDEO(X1,Y1,X2,Y2,PIC,BT)
	FSBR	Y2,YH		;IF BT IS -1,
	FMPR	Y2,YSC		;PUT UP A RANDOM DOT REPRESENTATION INSTEAD
	FIX	Y2,
	POP	P,X2
	FSBR	X2,XL
	FMPR	X2,XSC
	FIX	X2,
	POP	P,Y1
	FSBR	Y1,YH
	FMPR	Y1,YSC
	FIX	Y1,
	POP	P,X1
	FSBR	X1,XL
	FMPR	X1,XSC
	FIX	X1,
	SAVAC(17)
	JSR	SETUP
	CAMN	BT,[-1]
	JRST	[	JSR	TONUP
			JRST	DONE  ]
	CAMN	BT,[-2]
	JRST	[	JSR	HAFUP
			JRST	DONE  ]
	JSR	GRYUP
DONE:	RESAC(17)
	JRST	@RETAD

ARRY←5 ↔ X1←1 ↔ Y1←2 ↔ X2←3 ↔ Y2←4 ↔ BT←0 ↔ XA←6 ↔ YA←7
DX←10 ↔ DY←11 ↔ PICX←12 ↔ PICY←13 ↔ XBIT←14 ↔ XPIC←15 ↔ YPIC←16 ↔ T←17
THISS:	0
SIZS:	0
HAFUP:	0				;AN ARTY halftone BUG
	MOVE	T,ROWTAB
	HRRM	T,RTF2
	MOVE	T,COLTAB
	HRRM	T,CTF2
	HRRM	T,CTF2A
	CAML	X1,X2			;PUT UP THE BITS MASKED BY BT
	EXCH	X1,X2			;OF PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2
	HRREI	XA,1(X2)
	SUB	XA,X1
	HRREI	YA,1(Y2)
	SUB	YA,Y1
	HRLZ	DX,PICWID
	IDIV	DX,XA
	HRLZ	DY,PICHIG
	IDIV	DY,YA
	SETZB	PICY,PICX
	JUMPGE	Y1,YLOK2		;CHECK IF LOWER AND UPPER
	MOVN	PICY,Y1			;BOUNDS NEED FIXING UP
	IMUL	PICY,DY
	SETZ	Y1,
YLOK2:	CAILE	Y2,740
	MOVEI	Y2,740
	JUMPGE	X1,XLOK2
	MOVN	PICX,X1
	IMUL	PICX,DX
	SETZ	X1,
XLOK2:	CAIL	X2,21*40
	MOVEI	X2,21*40
	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	@HAFUP

LINA←←0 ↔ LINB←←0 ↔ HALFV←←0		;DUMMY NAMES FOR LINE BUFFER AND 1/2 PIXEL

THIS←Y1 ↔ SIZ←X2
	MOVEM	THIS,THISS		;SAVE THESE
	MOVEM	SIZ,SIZS		;ALLOCATE CORE FOR TWO LINE BUFFERS
	EXCH	P,ACS17
	MOVEI	SIZ,2000
	PUSHJ	P,CORGET
	HALT
	ADDI	THIS,2
	HRRM	THIS,LAAM		;SET UP LINE BUFFER REFERENCES
	ADDI	THIS,1
	HRRM	THIS,LBA
	HRRM	THIS,LAA
	ADDI	THIS,1
	HRRM	THIS,LAAP
	HRRM	THIS,LBAP
	ADDI	THIS,1000
	HRRM	THIS,LABM
	ADDI	THIS,1
	HRRM	THIS,LBB
	HRRM	THIS,LAB
	ADDI	THIS,1
	HRRM	THIS,LABP
	HRRM	THIS,LBBP
	SUBI	THIS,1006
	SETZM	(THIS)
	HRL	BT,THIS
	HRRI	BT,1(THIS)
	BLT	BT,1777(THIS)
	EXCH	THIS,THISS
	MOVE	SIZ,SIZS
	EXCH	P,ACS17

	MOVEI	BT,1				;BYTE WIDTH CALCULATION
	LSH	BT,@PICBIT
	HRRM	BT,LBH
	HRRM	BT,LDH
	LSH	BT,-1
	HRRM	BT,LAH
	HRRM	BT,LCH

	SUBM	X1,X2
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)
	MOVE	YA,Y1
YLLP2:	HLRZ	YPIC,PICY
RTF2:	MOVE	YPIC,ROWTAB(YPIC)
	MOVEM	YPIC,SCRTCH(YA)
	ADD	PICY,DY
	AOBJN	YA,YLLP2

XLP2:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TJ2
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF2:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLP2:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
	SETZ	BT,
LAA:	EXCH	BT,LINA(YA)		;CHANGED TO LINA
	ADD	BT,T
LAH:	CAIGE	BT,HALFV		;CHANGED TO ACTUAL 1/2 MAX PIXEL VALUE
	JRST	GTH
	MOVE	YPIC,SLINE(YA)
TJ2:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
LBH:	SUBI	BT,HALFV
GTH:	MOVE	T,BT
	ASH	BT,-2
LABM:	ADDM	BT,LINB-1(YA)		;CHNGED TO ACTUAL ADDR-1 OF LINB BUFFER
LAB:	ADDM	BT,LINB(YA)
	SUB	T,BT
	SUB	T,BT
	ASH	BT,-1
LABP:	ADDM	BT,LINB+1(YA)
	SUB	T,BT
LAAP:	ADDM	T,LINA+1(YA)
	AOBJN	YA,YLP2
					;POSSIBLE PATTERNS ARE
					;     *  7        *  3        *  2
					;  3  5  1     2  2  1     1  1  0
	ADD	PICX,DX
	AOBJP	X1,ENDXL

XLP2A:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TI2
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF2A:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLP2A:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
	SETZ	BT,
LBB:	EXCH	BT,LINB(YA)		;CHANGED TO LINA
	ADD	BT,T
LCH:	CAIGE	BT,HALFV		;CHANGED TO ACTUAL 1/2 MAX PIXEL VALUE
	JRST	GTH1
	MOVE	YPIC,SLINE(YA)
TI2:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
LDH:	SUBI	BT,HALFV
GTH1:	MOVE	T,BT
	ASH	BT,-2
LAAM:	ADDM	BT,LINA-1(YA)		;CHNGED TO ACTUAL ADDR-1 OF LINB BUFFER
LBA:	ADDM	BT,LINA(YA)
	SUB	T,BT
	SUB	T,BT
	ASH	BT,-1
LBAP:	ADDM	BT,LINA+1(YA)
	SUB	T,BT
LBBP:	ADDM	T,LINB+1(YA)
	AOBJN	YA,YLP2A

	ADD	PICX,DX
	AOBJN	X1,XLP2

ENDXL:	MOVE	P,ACS17
	MOVE	THIS,THISS
	PUSHJ	P,CORREL

	JRST	@HAFUP

	END